home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / forth / cforthu.arc / NF.C < prev    next >
C/C++ Source or Header  |  1985-07-11  |  19KB  |  752 lines
  1. /* nf.c -- this program can be run to generate a new environment for the
  2.  * FORTH interpreter forth.c. It takes the dictionary from the standard input.
  3.  * Normally, this dictionary is in the file "forth.dict", so 
  4.  *    nf < forth.dict
  5.  * will do the trick.
  6.  */
  7.  
  8. #include <stdio.h>
  9. #include <ctype.h>
  10. #include "common.h"
  11. #include "forth.lex.h"        /* #defines for lexical analysis */
  12.  
  13. #define isoctal(c)    (c >= '0' && c <= '7')    /* augument ctype.h */
  14.  
  15. #define assert(c,s)    (!(c) ? failassert(s) : 1)
  16. #define chklit()    (!prev_lit ? dictwarn("Qustionable literal") : 1)
  17.  
  18. #define LINK struct linkrec
  19. #define CHAIN struct chainrec
  20.  
  21. struct chainrec {
  22.     char chaintext[32];
  23.     int defloc;                /* CFA or label loc */
  24.     int chaintype;            /* 0=undef'd, 1=absolute, 2=relative */
  25.     CHAIN *nextchain;
  26.     LINK *firstlink;
  27. };
  28.  
  29. struct linkrec {
  30.     int loc;
  31.     LINK *nextlink;
  32. };
  33.  
  34. CHAIN firstchain;
  35.  
  36. #define newchain()    (CHAIN *)(calloc(1,sizeof(CHAIN)))
  37. #define newlink()    (LINK *)(calloc(1,sizeof(LINK)))
  38.  
  39. CHAIN *find();
  40. CHAIN *lastchain();
  41. LINK *lastlink();
  42.  
  43. char *strcat();
  44. char *calloc();
  45.  
  46. int dp = DPBASE;
  47. int latest;
  48.  
  49. short mem[INITMEM];
  50.  
  51. FILE *outf, *fopen();
  52.  
  53. main(argc, argv)
  54. int argc;
  55. char *argv[];
  56. {
  57. #ifdef DEBUG
  58.     puts("Opening output file");
  59. #endif DEBUG
  60.  
  61.     strcpy(firstchain.chaintext," ** HEADER **");
  62.     firstchain.nextchain = NULL;
  63.     firstchain.firstlink = NULL;
  64.  
  65. #ifdef DEBUG
  66.     puts("call builddict");
  67. #endif DEBUG
  68.     builddict();
  69. #ifdef DEBUG
  70.     puts("Make FORTH and COLDIP");
  71. #endif DEBUG
  72.     mkrest();
  73. #ifdef DEBUG
  74.     puts("Call Buildcore");
  75. #endif DEBUG
  76.     buildcore();
  77. #ifdef DEBUG
  78.     puts("call checkdict");
  79. #endif DEBUG
  80.     checkdict();
  81. #ifdef DEBUG
  82.     puts("call writedict");
  83. #endif DEBUG
  84.     writedict();
  85.  
  86.     printf("%s: done.\n", argv[0]);
  87. }
  88.  
  89. buildcore()            /* set up low core */
  90. {
  91.     mem[USER_DEFAULTS+0] = INITS0;            /* initial S0 */
  92.     mem[USER_DEFAULTS+1] = INITR0;            /* initial R0 */
  93.     mem[USER_DEFAULTS+2] = TIB_START;        /* initial TIB */
  94.     mem[USER_DEFAULTS+3] = MAXWIDTH;        /* initial WIDTH */
  95.     mem[USER_DEFAULTS+4] = 0;            /* initial WARNING */
  96.     mem[USER_DEFAULTS+5] = dp;            /* initial FENCE */
  97.     mem[USER_DEFAULTS+6] = dp;            /* initial DP */
  98.     mem[USER_DEFAULTS+7] = instance("FORTH") + 3;    /* initial CONTEXT */
  99.  
  100.     mem[SAVEDIP] = 0;                /* not a saved FORTH */
  101. }
  102.  
  103. builddict()            /* read the dictionary */
  104. {
  105.     int prev_lit = 0, lit_flag = 0;
  106.     int temp;
  107.     char s[256];
  108.     TOKEN *token;
  109.  
  110.     while ((token = yylex()) != NULL) {    /* EOF returned as a null pointer */
  111. #ifdef DEBUG
  112.     printf("\ntoken: %s: %d ",token->text, token->type);
  113. #endif DEBUG
  114.     switch (token->type) {
  115.  
  116.     case PRIM:
  117. #ifdef DEBUG
  118.         printf("primitive ");
  119. #endif DEBUG
  120.         if ((token = yylex()) == NULL)    /* get the next word */
  121.         dicterr("No word following PRIM");
  122.         strcpy (s,token->text);
  123. #ifdef DEBUG
  124.         printf(".%s. ",s);
  125. #endif DEBUG
  126.         if ((token == yylex()) == NULL)    /* get the value */
  127.         dicterr("No value following PRIM <word>");
  128.         mkword(s,mkval(token));
  129.         break;
  130.  
  131.     case CONST:
  132. #ifdef DEBUG
  133.         printf("constant ");
  134. #endif DEBUG
  135.         if ((token = yylex()) == NULL)    /* get the word */
  136.         dicterr("No word following CONST");
  137.         strcpy (s,token->text);        /* s holds word */
  138. #ifdef DEBUG
  139.         printf(".%s. ",s);
  140. #endif DEBUG
  141.         if (!find("DOCON"))
  142.         dicterr ("Constant definition before DOCON: %s",s);
  143.                 /* put the CF of DOCON into this word's CF */
  144.         mkword(s,(int)mem[instance("DOCON")]);
  145.         if ((token = yylex()) == NULL)    /* get the value */
  146.         dicterr("No value following CONST <word>");
  147.         temp = mkval(token);
  148.  
  149.         /* two special-case constants */
  150.         if (strcmp(s,"FIRST") == 0) temp = INITR0;
  151.         else if (strcmp(s,"LIMIT") == 0) temp = DPBASE;
  152.  
  153.         comma(temp);
  154.         break;
  155.  
  156.     case VAR:
  157. #ifdef DEBUG
  158.         printf("variable ");
  159. #endif DEBUG
  160.         if ((token = yylex()) == NULL)    /* get the variable name */
  161.         dicterr("No word following VAR");
  162.         strcpy (s,token->text);
  163. #ifdef DEBUG
  164.         printf(".%s. ",s);
  165. #endif DEBUG
  166.         if (!find("DOVAR"))
  167.         dicterr("Variable declaration before DOVAR: %s",s);
  168.         mkword (s, (int)mem[instance("DOVAR")]);
  169.         if ((token = yylex()) == NULL)    /* get the value */
  170.         dicterr("No value following VAR <word>");
  171.         comma(mkval(token));
  172.         break;
  173.  
  174.     case USER:
  175. #ifdef DEBUG
  176.         printf("uservar ");
  177. #endif DEBUG
  178.         if ((token = yylex()) == NULL)    /* get uservar name */
  179.         dicterr("No name following USER");
  180.         strcpy (s,token->text);
  181. #ifdef DEBUG
  182.         printf(".%s. ",s);
  183. #endif DEBUG
  184.         if (!find("DOUSE"))
  185.         dicterr("User variable declared before DOUSE: %s",s);
  186.         mkword (s, (int)mem[instance("DOUSE")]);
  187.         if ((token = yylex()) == NULL)    /* get the value */
  188.         dicterr("No value following USER <word>");
  189.         comma(mkval(token));
  190.         break;
  191.  
  192.     case COLON:
  193. #ifdef DEBUG
  194.         printf("colon def'n ");
  195. #endif DEBUG
  196.         if ((token = yylex()) == NULL)    /* get name of word */
  197.         dicterr("No word following : in definition");
  198.         strcpy (s,token->text);
  199. #ifdef DEBUG
  200.         printf(".%s.\n",s);
  201. #endif DEBUG
  202.         if (!find("DOCOL"))
  203.         dicterr("Colon definition appears before DOCOL: %s",s);
  204.  
  205.         if (token->type == NUL) {    /* special zero-named word */
  206.         int here = dp;        /* new latest */
  207. #ifdef DEBUG
  208.         printf("NULL WORD AT 0x%04x\n");
  209. #endif DEBUG
  210.         comma(0xC1);
  211.         comma(0x80);
  212.         comma(latest);
  213.         latest = here;
  214.         comma((int)mem[instance("DOCOL")]);
  215.         }
  216.         else {
  217.         mkword (s, (int)mem[instance("DOCOL")]);
  218.         }
  219.         break;
  220.  
  221.     case SEMICOLON:
  222. #ifdef DEBUG
  223.         puts("end colon def'n");
  224. #endif DEBUG
  225.         comma (instance(";S"));
  226.         break;
  227.  
  228.     case SEMISTAR:
  229. #ifdef DEBUG
  230.         printf("end colon w/IMMEDIATE ");
  231. #endif DEBUG
  232.         comma (instance (";S"));    /* compile cfA of ;S, not CF */
  233.         mem[latest] |= IMMEDIATE;    /* make the word immediate */
  234.         break;
  235.  
  236.     case STRING_LIT:
  237. #ifdef DEBUG
  238.         printf("string literal ");
  239. #endif DEBUG
  240.         strcpy(s,token->text);
  241.         mkstr(s);        /* mkstr compacts the string in place */
  242. #ifdef DEBUG
  243.         printf("string=(%d) \"%s\" ",strlen(s),s);
  244. #endif DEBUG
  245.         comma(strlen(s));
  246.         {
  247.         char *stemp;
  248.         stemp = s;
  249.         while (*stemp) comma(*stemp++);
  250.         }
  251.         break;
  252.     
  253.     case COMMENT:
  254. #ifdef DEBUG
  255.         printf("comment ");
  256. #endif DEBUG
  257.         skipcomment();
  258.         break;
  259.  
  260.     case LABEL:
  261. #ifdef DEBUG
  262.         printf("label: ");
  263. #endif DEBUG
  264.         if ((token = yylex()) == NULL)
  265.         dicterr("No name following LABEL");
  266. #ifdef DEBUG
  267.         printf(".%s. ", token->text);
  268. #endif DEBUG
  269.         define(token->text,2);    /* place in sym. table w/o compiling
  270.                        anything into dictionary; 2 means
  271.                        defining a label */
  272.         break;
  273.  
  274.     case LIT:
  275.         lit_flag = 1;        /* and fall through to the rest */
  276.  
  277.     default:
  278.         if (find(token->text) != NULL) {    /* is word defined? */
  279. #ifdef DEBUG
  280.         printf("  normal: %s\n",token->text);
  281. #endif DEBUG
  282.             comma (instance (token->text));
  283.         break;
  284.         }
  285.  
  286.         /* else */
  287.         /* the literal types all call chklit(). This macro checks to
  288.            if the previous word was "LIT"; if not, it warns */
  289.         switch(token->type) {
  290.         case DECIMAL: chklit(); comma(mkdecimal(token->text)); break;
  291.         case HEX: chklit(); comma(mkhex(token->text)); break;
  292.         case OCTAL: chklit(); comma(mkoctal(token->text)); break;
  293.         case C_BS: chklit(); comma('\b'); break;
  294.         case C_FF: chklit(); comma('\f'); break;
  295.         case C_NL: chklit(); comma('\n'); break;
  296.         case C_CR: chklit(); comma('\r'); break;
  297.         case C_TAB: chklit(); comma('\t'); break;
  298.         case C_BSLASH: chklit(); comma(0x5c); break;  /* ASCII backslash */
  299.         case C_LIT: chklit(); comma(*((token->text)+1)); break;
  300.  
  301.         default:
  302. #ifdef DEBUG
  303.         printf("forward reference");
  304. #endif DEBUG
  305.         comma (instance (token->text));        /* create an instance,
  306.                         to be resolved at definition */
  307.         }
  308.     }
  309. #ifdef DEBUG
  310.     if (lit_flag) puts("expect a literal");
  311. #endif DEBUG
  312.     prev_lit = lit_flag;    /* to be used by chklit() next time */
  313.     lit_flag = 0;
  314.     }
  315. }
  316.  
  317. comma(i)            /* put at mem[dp]; increment dp */
  318. {
  319.     mem[dp++] = (unsigned short)i;
  320.     if (dp > INITMEM) dicterr("DICTIONARY OVERFLOW");
  321. }
  322.  
  323. /*
  324.  * make a word in the dictionary.  the new word will have name *s, its CF
  325.  * will contain v. Also, resolve any previously-unresolved references by
  326.  * calling define()
  327.  */
  328.  
  329. mkword(s, v)
  330. char *s;
  331. short v;
  332. {
  333.     int here, count = 0;
  334.     char *olds;
  335.     olds = s;        /* preserve this for resolving references */
  336.  
  337. #ifdef DEBUG
  338.     printf("%s ",s);
  339. #endif DEBUG
  340.  
  341.     here = dp;        /* hold this value to place length byte */
  342.  
  343.     while (*s) {        /* for each character */
  344.         mem[++dp] = (unsigned short)*s;
  345.         count++; s++;
  346.     }
  347.  
  348.     if (count >= MAXWIDTH) dicterr("Input word name too long");
  349.  
  350.                 /* set MSB on */
  351.     mem[here] = (short)(count | 0x80);
  352.  
  353.     mem[dp++] |= 0x80;    /* set hi bit of last char in name */
  354.     
  355.     mem[dp++] = (short)latest;    /* the link field */
  356.  
  357.     latest = here;        /* update the link */
  358.  
  359.     mem[dp] = v;        /* code field; leave dp = CFA */
  360.  
  361.     define(olds,1);        /* place in symbol table. 1 == "not a label" */
  362.     dp++;            /* now leave dp holding PFA */
  363.  
  364.     /* that's all. Now dp points (once again) to the first UNallocated
  365.            spot in mem, and everybody's happy. */
  366. }
  367.  
  368. mkrest()            /* Write out the word FORTH as a no-op with
  369.                    DOCOL as CF, ;S as PF, followed by
  370.                    0xA081, and latest in its PF.
  371.                    Also, Put the CFA of ABORT at 
  372.                    mem[COLDIP] */
  373. {
  374.     int temp;
  375.  
  376.     mem[COLDIP] = dp;    /* the cold-start IP is here, and the word
  377.                    which will be executed is COLD */
  378.     if ((mem[dp++] = instance("COLD")) == 0)
  379.         dicterr("COLD must be defined to take control at startup");
  380.  
  381.     mem[ABORTIP] = dp;    /* the abort-start IP is here, and the word
  382.                    which will be executed is ABORT */
  383.     if ((mem[dp++] = instance("ABORT")) == 0)
  384.         dicterr("ABORT must be defined to take control at interrupt");
  385.  
  386.     mkword("FORTH",mem[instance("DOCOL")]);
  387.     comma(instance(";S"));
  388.     comma(0xA081);    /* magic number for vocabularies */
  389.     comma(latest);        /* NFA of last word in dictionary: FORTH */
  390.  
  391.     mem[LIMIT] = dp + 1024;
  392.     if (mem[LIMIT] >= INITMEM) mem[LIMIT] = INITMEM-1;
  393. }
  394.  
  395. writedict()            /* write memory to COREFILE and map 
  396.                       to MAPFILE */
  397. {
  398.     FILE   *outfile;
  399.     int     i, temp, tempb, firstzero, nonzero;
  400.     char    chars[9], outline[80], tstr[6];
  401.  
  402.     outfile = fopen(MAPFILE,"w");
  403.  
  404.     for (temp = 0; temp < dp; temp += 8) {
  405.     nonzero = FALSE;
  406.     sprintf (outline, "%04x:", temp);
  407.     for (i = temp; i < temp + 8; i++) {
  408.         sprintf (tstr, " %04x", (unsigned short) mem[i]);
  409.         strcat (outline, tstr);
  410.         tempb = mem[i] & 0x7f;
  411.         if (tempb < 0x7f && tempb >= ' ')
  412.         chars[i % 8] = tempb;
  413.         else
  414.         chars[i % 8] = '.';
  415.         nonzero |= mem[i];
  416.     }
  417.     if (nonzero) {
  418.         fprintf (outfile, "%s %s\n", outline, chars);
  419.         firstzero = TRUE;
  420.     }
  421.     else
  422.         if (firstzero) {
  423.         fprintf (outfile, "----- ZERO ----\n");
  424.         firstzero = FALSE;
  425.         }
  426.     }
  427.     fclose (outfile);
  428.  
  429.  
  430.     printf ("Writing %s; DPBASE=%d; dp=%d\n", COREFILE, DPBASE, dp);
  431.  
  432.     if ((outf = fopen (COREFILE, "w")) == NULL) {
  433.     printf ("nf: can't open %s for output.\n", COREFILE);
  434.     exit (1);
  435.     }
  436.  
  437.     if (fwrite (mem, sizeof (*mem), mem[LIMIT], outf) != mem[LIMIT]) {
  438.     fprintf (stderr, "Error writing to %s\n", COREFILE);
  439.     exit (1);
  440.     }
  441.  
  442.     if (fclose (outf) == EOF) {
  443.     fprintf (stderr, "Error closing %s\n", COREFILE);
  444.     exit (1);
  445.     }
  446. }
  447.  
  448. mkval(t)            /* convert t->text to integer based on type */
  449. TOKEN *t;
  450. {
  451.     char *s = t->text;
  452.     int sign = 1;
  453.  
  454.     if (*s == '-') {
  455.         sign = -1;
  456.         s++;
  457.     }
  458.  
  459.     switch (t->type) {
  460.     case DECIMAL:
  461.         return (sign * mkdecimal(s));
  462.     case HEX:
  463.         return (sign * mkhex(s));
  464.     case OCTAL:
  465.         return (sign * mkoctal(s));
  466.     default:
  467.         dicterr("Bad value following PRIM, CONST, VAR, or USER");
  468.     }
  469. }
  470.  
  471. mkhex(s)
  472. char *s;
  473. {                /*  convert hex ascii to integer */
  474.     int     temp;
  475.     temp = 0;
  476.  
  477.     s += 2;            /* skip over '0x' */
  478.     while (isxdigit (*s)) {    /* first non-hex char ends */
  479.     temp <<= 4;        /* mul by 16 */
  480.     if (isupper (*s))
  481.         temp += (*s - 'A') + 10;
  482.     else
  483.         if (islower (*s))
  484.         temp += (*s - 'a') + 10;
  485.         else
  486.         temp += (*s - '0');
  487.     s++;
  488.     }
  489.     return temp;
  490. }
  491.  
  492. mkoctal(s)
  493. char *s;
  494. {                /*  convert Octal ascii to integer */
  495.     int     temp;
  496.     temp = 0;
  497.  
  498.     while (isoctal (*s)) {    /* first non-octal char ends */
  499.     temp = temp * 8 + (*s - '0');
  500.     s++;
  501.     }
  502.     return temp;
  503. }
  504.  
  505. mkdecimal(s)            /* convert ascii to decimal */
  506. char *s;
  507. {
  508.     return (atoi(s));    /* alias */
  509. }
  510.  
  511. dicterr(s,p1)
  512. char *s;
  513. int p1;        /* might be char * -- printf uses it */
  514. {
  515.     fprintf(stderr,s,p1);
  516.     fprintf(stderr,"\nLast word defined was ");
  517.     printword(latest);
  518. /*    fprintf(stderr, "; last word read was \"%s\"", token->text); */
  519.     fprintf(stderr,"\n");
  520.     exit(1);
  521. }
  522.  
  523. dictwarn(s)        /* almost like dicterr, but don't exit */
  524. char *s;
  525. {
  526.     fprintf(stderr,"\nWarning: %s\nLast word read was ",s);
  527.     printword(latest);
  528.     putc('\n',stderr);
  529. }
  530.     
  531. printword(n)
  532. int n;
  533. {
  534.     int count, tmp;
  535.     count = mem[n] & 0x1f;
  536.     for (n++;count;count--,n++) {
  537.     tmp = mem[n] & ~0x80;        /* mask eighth bit off */
  538.     if (tmp >= ' ' && tmp <= '~') putc(tmp, stderr);
  539.     }
  540. }
  541.  
  542. skipcomment()
  543. {
  544.     while(getchar() != ')');
  545. }
  546.  
  547. mkstr(s)            /* modifies a string in place with escapes
  548.                    compacted. Strips leading & trailing \" */
  549. char *s;
  550. {
  551.     char *source;
  552.     char *dest;
  553.  
  554.     source = dest = s;
  555.     source++;            /* skip leading quote */
  556.     while (*source != '"') {    /* string ends with unescaped \" */
  557.     if (*source == '\\') {    /* literal next */
  558.         source++;
  559.     }
  560.     *dest++ = *source++;
  561.     }
  562.     *dest = '\0';
  563. }
  564.  
  565. failassert(s)
  566. char *s;
  567. {
  568.     puts(s);
  569.     exit(1);
  570. }
  571.  
  572. checkdict()            /* check for unresolved references */
  573. {
  574.     CHAIN *ch = &firstchain;
  575.  
  576. #ifdef DEBUG
  577.     puts("\nCheck for unresolved references");
  578. #endif DEBUG
  579.     while (ch != NULL) {
  580. #ifdef DEBUG
  581.     printf("ch->chaintext = .%s. - ",ch->chaintext);
  582. #endif DEBUG
  583.     if ((ch->firstlink) != NULL) {
  584.         fprintf(stderr,"Unresolved forward reference: %s\n",ch->chaintext);
  585. #ifdef DEBUG
  586.         puts("still outstanding");
  587. #endif DEBUG
  588.     }
  589. #ifdef DEBUG
  590.     else puts("clean.");
  591. #endif DEBUG
  592.     ch = ch->nextchain;
  593.     }
  594. }
  595.  
  596.     
  597. /********* structure-handling functions find(s), define(s,t), instance(s) **/
  598.  
  599. CHAIN *find(s)        /* returns a pointer to the chain named s */
  600. char *s;
  601. {
  602.     CHAIN *ch;
  603.     ch = &firstchain;
  604.     while (ch != NULL) {
  605.         if (strcmp (s, ch->chaintext) == 0) return ch;
  606.         else ch = ch->nextchain;
  607.     }
  608.     return NULL;    /* not found */
  609. }
  610.  
  611. /* define must create a symbol table entry if none exists, with type t.
  612.    if one does exist, it must have type 0 -- it is an error to redefine
  613.    something at this stage. Change to type t, and fill in the outstanding
  614.    instances, with the current dp if type=1, or relative if type=2. */
  615.  
  616. define(s,t)        /* define s at current dp */
  617. char *s;
  618. int t;
  619. {
  620.     CHAIN *ch;
  621.     LINK *ln, *templn;
  622.  
  623. #ifdef DEBUG
  624.     printf("define(%s,%d)\n",s,t);
  625. #endif DEBUG
  626.  
  627.     if (t < 1 || t > 2)    /* range check */
  628.         dicterr("Program error: type in define() not 1 or 2.");
  629.  
  630.     if ((ch = find(s)) != NULL) {        /* defined or instanced? */
  631.         if (ch -> chaintype != 0)    /* already defined! */
  632.             dicterr("Word already defined: %s",s);
  633.         else {
  634. #ifdef DEBUG
  635.             printf("there are forward refs: ");
  636. #endif DEBUG
  637.             ch->chaintype = t;
  638.             ch->defloc = dp;
  639.         }
  640.     }
  641.     else {                /* must create a (blank) chain */
  642. #ifdef DEBUG
  643.         puts("no forward refs");
  644. #endif DEBUG
  645.         /* create a new chain, link it in, leave ch pointing to it */
  646.         ch = ((lastchain() -> nextchain) = newchain());
  647.         strcpy(ch->chaintext, s);
  648.         ch->chaintype = t;
  649.         ch->defloc = dp;    /* fill in for future references */
  650.     }
  651.  
  652.     /* now ch points to the chain (possibly) containing forward refs */
  653.     if ((ln = ch->firstlink) == NULL) return;    /* no links! */
  654.  
  655.     while (ln != NULL) {
  656. #ifdef DEBUG
  657.         printf("    Forward ref at 0x%x\n",ln->loc);
  658. #endif DEBUG
  659.         switch (ch->chaintype) {
  660.         case 1: mem[ln->loc] = (short)dp;    /* absolute */
  661.             break;
  662.         case 2: mem[ln->loc] = (short)(dp - ln->loc);    /* relative */
  663.             break;
  664.         default: dicterr ("Bad type field in define()");
  665.         }
  666.  
  667.         /* now skip to the next link & free this one */
  668.         templn = ln;
  669.         ln = ln->nextlink;
  670.         free(templn);
  671.     }
  672.     ch->firstlink = NULL;    /* clean up that last pointer */
  673. }
  674.  
  675. /*
  676.    instance must return a value to be compiled into the dictionary at
  677.    dp, consistent with the symbol s: if s is undefined, it returns 0,
  678.    and adds this dp to the chain for s (creating that chain if necessary).
  679.    If s IS defined, it returns <s> (absolute) or (s-dp) (relative), 
  680.    where <s> was the dp when s was defined.
  681. */
  682.  
  683. instance(s)
  684. char *s;
  685. {
  686.     CHAIN *ch;
  687.     LINK *ln;
  688.  
  689. #ifdef DEBUG
  690.     printf("instance(%s):\n",s);
  691. #endif DEBUG
  692.  
  693.     if ((ch = find(s)) == NULL) {    /* not defined yet at all */
  694. #ifdef DEBUG
  695.         puts("entirely new -- create a new chain");
  696. #endif DEBUG
  697.         /* create a new chain, link it in, leave ch pointing to it */
  698.         ch = ((lastchain() -> nextchain) = newchain());
  699.  
  700.         strcpy(ch->chaintext, s);
  701.         ln = newlink();        /* make its link */
  702.         ch->firstlink = ln;
  703.         ln->loc = dp;        /* store this location there */
  704.         return 0;        /* all done */
  705.     }
  706.     else {
  707.         switch(ch->chaintype) {
  708.         case 0:            /* not defined yet */
  709. #ifdef DEBUG
  710.             puts("still undefined -- add a link");
  711. #endif DEBUG
  712.             /* create a new link, point the last link to it, and
  713.                fill in the loc field with the current dp */
  714.             (lastlink(ch)->nextlink = newlink()) -> loc = dp;
  715.             return 0;
  716.         case 1:            /* absolute */
  717. #ifdef DEBUG
  718.             puts("defined absolute.");
  719. #endif DEBUG
  720.             return ch->defloc;
  721.         case 2:            /* relative */
  722. #ifdef DEBUG
  723.             puts("defined relative.");
  724. #endif DEBUG
  725.             return ch->defloc - dp;
  726.         default:
  727.             dicterr("Program error: bad type for chain");
  728.         }
  729.     }
  730. }
  731.  
  732. CHAIN *lastchain()    /* starting from firstchain, find the last chain */
  733. {
  734.     CHAIN *ch = &firstchain;
  735.     while (ch->nextchain != NULL) ch = ch->nextchain;
  736.     return ch;
  737. }
  738.  
  739. LINK *lastlink(ch)    /* return the last link in the chain */
  740. CHAIN *ch;        /* CHAIN MUST HAVE AT LEAST ONE LINK */
  741. {
  742.     LINK *ln = ch->firstlink;
  743.  
  744.     while (ln->nextlink != NULL) ln = ln->nextlink;
  745.     return ln;
  746. }
  747.  
  748. yywrap()    /* called by yylex(). returning 1 means "all finished" */
  749. {
  750.     return 1;
  751. }
  752.